module InterIRSlice where

import SliceADT
import Utils
import SliceSummary
import qualified IntraIRSlice as Intra

import Control.Lens ( (.~), (%~), (^.) )
import Control.Monad.RWS.Strict
import Data.Map ( Map )
import qualified Data.Map as M
import Data.IntMap ( IntMap )
import qualified Data.IntMap as IM
import Data.IntSet ( IntSet )
import qualified Data.IntSet as IS

import LLVM.Analysis


sliceTransfer :: SliceInfo -> Instruction -> Analysis SliceInfo
sliceTransfer si i =   
  case i of  
    CallInst { callFunction = fv, callArguments = avs } ->
      callTransfer si i fv (map fst avs)
    InvokeInst { invokeFunction = fv, invokeArguments = avs } ->
      callTransfer si i fv (map fst avs)
            
    _ -> Intra.sliceTransfer si i


callTransfer :: SliceInfo -> Instruction -> Value -> [Value] -> Analysis SliceInfo
callTransfer si i fv args = do
  env <- ask
  let ptM = procSliTbl env
      paraMap = paraValMap env
  l0 <- getInstDep i
  
  let l = instructionUniqueId i
      ss = si ^. sliceTable
      
  case valueContent' fv of
    FunctionC f -> do
      let frmlIds = map valueUniqueId (functionParameters f)
          argMap = IM.filterWithKey mapF paraMap
             where mapF n (v,k) = k == -1 || elem n frmlIds
--          argMap = IM.fromList. zip(map argumentUniqueId argFrmls)$ zip argFrmls args

          fName = identifierAsString . functionName $ f          
          procSli = M.findWithDefault M.empty fName ptM 
          
          --           
          (argInMap,outMap) = IM.mapEitherWithKey mapF argMap
            where mapF n (v,k) = if isArgIn n v then Left (toVarName' v) 
                                  else Right (v,k)
                  isArgIn n v = lkpSli (toVarName' v) procSli == IS.singleton (negate n)
          argOutMap = IM.map mapF outMap
            where mapF (v,k) = (toVarName' (actArg v k), lkpSli (toVarName' v) procSli')
                  actArg v k = if k == -1 then v else (args !! k)
                  
          procSli' = M.mapWithKey mapF procSli
            where mapF k lx = if elem k (IM.elems argInMap) 
                              then IS.empty else fillF lx
          fillF lx = IS.unions. (lx1:). map (lci. negate)$ IS.toList lx2
            where (lx1,lx2) = IS.partition (>0) lx
                  lci n = case IM.lookup n argMap of                
                           Just (gv,-1) -> lkpSli (toVarName' gv) ss 
                           Just (v,k) -> unionL' l l0 (args !! k, ss)
                           _  -> IS.singleton (negate n)   
                                
          si' = (sliceTable %~ updSlices argDefs lxs . M.unionWithKey mapF procSli') si
            where (argDefs,lxs) = unzip (IM.elems argOutMap)
                  mapF k lx' lx = if (head k == '@') && not(IS.null lx') 
                                  then lx' else IS.union lx' lx
                                  
          si2 = if M.null procSli then si else si'
      setTrCtrDep si2 i IS.empty
    ExternalFunctionC ef -> if not(isMemcpy fv) then setTrCtrDep si i IS.empty
                            else updSliInfo i (args!!0,args!!1) si    
    _ -> setTrCtrDep si i IS.empty


